perm filename OPENIT.FAI[SCR,LCS] blob
sn#544430 filedate 1980-11-07 generic text, type T, neo UTF8
; FORTRAN LOOKUP ROUTINE -- STUFFS NEW CODE INTO IFILE-OFILE
; CAN USE DEVICE NUMBERS 1, 20, 21, 22, 23, 24 (BUT NO PPN'S YET)
TITLE OPENIT
INTERNAL OPENIT
EXTERNAL FCM1,TEMP.,IFILE,OFILE
;; EXTERNAL FCM1,FNCTN.,TEMP.,IFILE,OFILE
NOEXT: PUSHJ 17,ZEXT
YESEXT: PUSHJ 17,ZEXT+2
ZEXT: SETZM TEMP.+1 ;FOR NO EXTENSION
POPJ 17,
MOVE 0,EXT#
MOVEM TEMP.+1 ;STUFF IN THE EXTENSION
POPJ 17,
NOFIND: JRST NOFILE
NOFILE: OUTSTR [ASCIZ/***** FILE NOT FOUND *****/]
EXIT
; CALL OPENIT(DEVICE#,NAME,EXT,[IN=0 OUT=1])
OPENIT: 0
MOVE 0,NOFIND
MOVEM 0,FCM1+14 ;STUFF IN NO FILE FOUND TRAP
MOVE 0,@(16)
MOVEM 0,DEVICE#
MOVE 0,@1(16)
MOVEM 0,NAME#
MOVE 0,@2(16)
JUMPE 0,NONE ;0 OR BLANK OK FOR NO EXTENSION
CAMN 0,[ASCIZ/ /] ;SEND EXTENSION IN A5 FORMAT ONLY!!!
JRST NONE
MOVEM 0,EX# ;NOW CONVERT EXTENSION TO SIXBIT
MOVE 1,[POINT 7,EX]
MOVE 2,[POINT 6,EXT]
SETZM EXT#
MOVEI 3,3 ;LOOK AT FIRST 3 CHARACTERS ONLY
INF1: ILDB 0,1 ;LOOP 3 TIMES
CAIN 0," " ;LESS THAN 3 CHARACTERS?
JRST OPE2
SUBI 0,40
IDPB 0,2
SOJG 3,INF1
OPE2: MOVE 0,YESEXT ;THERE IS AN EXTENSION
SKIPA
NONE: MOVE 0,NOEXT ;NO EXTENSION
;; MOVEM 0,FNCTN.-7 ;ONLY NEEDS ONE LOOKUP NOW.
MOVEM 0,FCM1-3 ;CAUSES BOTH FORTRAN LOOKUPS TO DO THE SAME THING.
SKIPE @3(16) ;0=INPUT 1=OUTPUT
JRST OUTFIL
JSA 16,IFILE ;OLD FORTRAN ROUTINES
JUMP DEVICE
JUMP NAME
JRA 16,4(16)
OUTFIL: JSA 16,OFILE ;OLD FORTRAN ROUTINES
JUMP DEVICE
JUMP NAME
JRA 16,4(16)
END